home *** CD-ROM | disk | FTP | other *** search
- /* INTERNAL CL DOCUMENTATION */
- /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
- /* */
- /* NAME: DATESPAN */
- /* */
- /* DESCRIPTION: DETERMINE THE NUMBER OF DAYS BETWEEN TWO */
- /* DATES. */
- /* */
- /* PARAMETERS: DATE1 (MMDDYY) */
- /* DATE2 (MMDDYY) */
- /* */
- /* SPANTYPE: */
- /* ( 1) INCLUDE DATE1 AND DATE2 IN THE SPAN */
- /* (-1) EXCLUDE DATE1 AND DATE2 FROM THE SPAN */
- /* ( 0) EXCLUDE DATE1, INCLUDE DATE2 */
- /* */
- /* DAYS RETURNS NUMBER OF DAYS */
- /* FLAG RETURN CODE = '*' FOR ERROR. */
- /* = ' ' NO ERROR. */
- /* */
- /* * * * * * * * * * * *MAINTENANCE LOG* * * * * * * * * * * * */
- /* */
- /* DATE DESCRIPTION OF CHANGE PROJECT# INITIALS */
- /* 11/19/86 LOG STARTED. 105 TWM */
- /* */
- /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
- PGM (&DATEN1 &DATEN2 &SPANTYPE &DAYS &FLAG)
- DCL VAR(&DATEN1) TYPE(*DEC) LEN(6 0)
- DCL VAR(&DATEN2) TYPE(*DEC) LEN(6 0)
- DCL VAR(&DATEA1) TYPE(*CHAR) LEN(6)
- DCL VAR(&DATEA2) TYPE(*CHAR) LEN(6)
- DCL VAR(&DATEA) TYPE(*CHAR) LEN(6)
- DCL VAR(&LASTDATE) TYPE(*CHAR) LEN(6) VALUE('123100')
- DCL VAR(&JDATEN1) TYPE(*DEC) LEN(5 0)
- DCL VAR(&JDATEA1) TYPE(*CHAR) LEN(5)
- DCL VAR(&JYEARA1) TYPE(*CHAR) LEN(2)
- DCL VAR(&JYEARN1) TYPE(*DEC) LEN(2 0)
- DCL VAR(&JDATEN2) TYPE(*DEC) LEN(5 0)
- DCL VAR(&JDATEA2) TYPE(*CHAR) LEN(5)
- DCL VAR(&JYEARA2) TYPE(*CHAR) LEN(2)
- DCL VAR(&JYEARN2) TYPE(*DEC) LEN(2 0)
- DCL VAR(&JHOLDN) TYPE(*DEC) LEN(5 0)
- DCL VAR(&JHOLDA) TYPE(*CHAR) LEN(5)
- DCL VAR(&SPANTYPE) TYPE(*DEC) LEN(1 0)
- DCL VAR(&DAYS) TYPE(*DEC) LEN(6 0)
- DCL VAR(&FLAG) TYPE(*CHAR) LEN(1)
-
- MONMSG MSGID(MCH1210) /* RECEIVING OPERAND TOO SMALL */
-
- /* VALIDATE DATES */
- CHGVAR VAR(&DATEA1) VALUE(&DATEN1)
- CVTDAT DATE(&DATEA1) TOVAR(&JDATEA1) FROMFMT(*MDY) +
- TOFMT(*JUL) TOSEP(*NONE)
- MONMSG MSGID(CPF0000) EXEC(GOTO ERROR)
- CVTDAT DATE(&JDATEA1) TOVAR(&DATEA) FROMFMT(*JUL) +
- TOFMT(*MDY) TOSEP(*NONE)
- MONMSG MSGID(CPF0000) EXEC(GOTO ERROR)
- IF COND(&DATEA1 *NE &DATEA) THEN(GOTO ERROR)
-
- CHGVAR VAR(&DATEA2) VALUE(&DATEN2)
- CVTDAT DATE(&DATEA2) TOVAR(&JDATEA2) FROMFMT(*MDY) +
- TOFMT(*JUL) TOSEP(*NONE)
- MONMSG MSGID(CPF0000) EXEC(GOTO ERROR)
- CVTDAT DATE(&JDATEA2) TOVAR(&DATEA) FROMFMT(*JUL) +
- TOFMT(*MDY) TOSEP(*NONE)
- MONMSG MSGID(CPF0000) EXEC(GOTO ERROR)
- IF COND(&DATEA2 *NE &DATEA) THEN(GOTO ERROR)
-
- /* DATES OK - PROCEED */
-
- CHGVAR VAR(&DAYS) VALUE(0)
- CHGVAR VAR(&FLAG) VALUE(' ')
- IF ((&SPANTYPE *LT (-1)) *OR (&SPANTYPE *GT (+1))) +
- THEN(CHGVAR &SPANTYPE 0)
-
- IF (&JDATEA1 *GT &JDATEA2) THEN(DO) /* SWAP DATES */
- CHGVAR &JHOLDA &JDATEA1
- CHGVAR &JDATEA1 &JDATEA2
- CHGVAR &JDATEA2 &JHOLDA
- ENDDO
-
- CHGVAR &JDATEN1 &JDATEA1
- CHGVAR &JDATEN2 &JDATEA2
-
- CHGVAR &JYEARA1 %SST(&JDATEA1 1 2) /* EXTRACT YEARS */
- CHGVAR &JYEARN1 &JYEARA1 /* TO ALPHA AND */
- CHGVAR &JYEARA2 %SST(&JDATEA2 1 2) /* NUMERIC FMTS.*/
- CHGVAR &JYEARN2 &JYEARA2
-
-
- /* IF YEARS ARE THE SAME, SIMPLY SUBTRACT */
- LOOP: IF COND(&JYEARN1 = &JYEARN2) THEN(DO)
- CHGVAR VAR(&DAYS) VALUE(&DAYS + (&JDATEN2 - +
- &JDATEN1) + &SPANTYPE)
- GOTO ENDPGM
- ENDDO
- ELSE
-
- /* OTHERWISE */
-
- CHGVAR %SST(&LASTDATE 5 2) &JYEARA1 /* 12-31-YR1 */
- CVTDAT DATE(&LASTDATE) TOVAR(&JHOLDA) FROMFMT(*MDY) +
- TOFMT(*JUL) TOSEP(*NONE)
-
- CHGVAR &JHOLDN &JHOLDA
- CHGVAR &DAYS (&DAYS + (&JHOLDN - &JDATEN1))
- CHGVAR &JYEARN1 (&JYEARN1 + 1)
- CHGVAR &JYEARA1 &JYEARN1
- CHGVAR &JDATEN1 (&JYEARN1 * 1000)
-
- GOTO LOOP
-
- ERROR: CHGVAR VAR(&FLAG) VALUE('*')
-
- ENDPGM: ENDPGM
-